Proyecto de Contingencias de Vida I

Punto A

  tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)

llamamos es script con los gráficos.

source('code/graficos_activos.R')

fig_hombres_vivos_activos

fig_mujeres_vivas_activas

Punto B

Punto C

fig_hombres_muertes_activos

fig_mujeres_muertes_activas

Punto D

Punto E

Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.

En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.

tablas_proy_fin <- proyeccion_financiera(tablas_activos, inflacion =  0.03)

fig_proy_financiera <- plot_ly(tablas_proy_fin, x = ~Annos) %>%
  add_lines(y = ~Total, name = 'Proyeccion', line = list(color = '#698B69')) %>%
  layout(
    title = "Proyeccion financiera de activos vivos según el año",
    xaxis = list(title = 'Edad'),
    yaxis = list(title = 'Personas'),
    legend = list(title = list(text = 'Estado'), orientation = 'h', xanchor = 'center', x = 0.5)
  )

fig_proy_financiera

Punto f

Proyeccion_beneficios_muerte_pensionados <- Proyeccion_financiera_muerte_pensionados(proy_pensionados_muertos = proy_pensionados_muertos, suma_asegurada_pensionados = 1000000)

fig_proy_finan_muerte_pen <- plot_ly(Proyeccion_beneficios_muerte_pensionados, x = ~Anno) %>%
  add_lines(y = ~beneficio_muerte, name = 'Proyeccion', line = list(color = '#698B69')) %>%
  layout(
    title = "Proyeccion de los beneficios por muerte para pensionados según el año",
    xaxis = list(title = 'Edad'),
    yaxis = list(title = 'Personas'),
    legend = list(title = list(text = 'Estado'), orientation = 'h', xanchor = 'center', x = 0.5)
  )

fig_proy_finan_muerte_pen

Punto g

Proyeccion_pension <- Proyeccion_financiera_pension(proy_pensionados_vivos = proy_pensionados_vivos, pension_mensual = 300000)

fig_proy_financiera_pension <- plot_ly(Proyeccion_pension, x = ~Anno) %>%
  add_lines(y = ~anualidad, name = 'Proyeccion', line = list(color = '#698B69')) %>%
  layout(
    title = "Proyeccion de pensiones según el año",
    xaxis = list(title = 'Edad'),
    yaxis = list(title = 'Personas'),
    legend = list(title = list(text = 'Estado'), orientation = 'h', xanchor = 'center', x = 0.5)
  )

fig_proy_financiera_pension

Punto h

Estas son las primas para cada empleado

Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000)

Punto i

Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.

Prima_nivelada <- (sum(Primas$beneficios) / sum(Primas$anualidad) )
ggplot(Primas, aes(x = log(Primas))) +
  geom_histogram(bins = 20, fill = "blue", color = "black") +
  geom_vline(xintercept = log(Prima_nivelada), color = "red", linetype = "dashed", size = 1) +
  geom_text(aes(x = log(Prima_nivelada), y = -Inf, label = "Log prima nivelada"), 
            color = "red", hjust = -0.2, vjust = -0.5) +
  labs(title = "Histograma de Primas a Pagar", x = "logaritmo primas", y = "Frecuencia") +
  theme_minimal()

Punto j

Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.

#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
                                  Menos_10_porciento = (Primas$Primas)*0.9)

La primera alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión 
# Primer año de pensión con mensualidad de 266.200 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266200)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas1_menos_10$Primas, 
                                    porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))

## [1] 90.00839

La Segunda alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión 
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas2_menos_10$Primas, 
                                    porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))

## [1] 90.01983

#36648B
tabla_para_graficar <- data.frame(Empleado = Primas$Empleado,
                                   original = Primas$Primas, 
                                   editada1 = Verifica1_90_porciento$editada, 
                                   editada2 = Verifica2_90_porciento$editada)

  fig_comparacion1 <- plot_ly(tabla_para_graficar, x = ~Empleado) %>%
  add_trace(y = ~original, name = 'Original', type = 'bar', marker = list(color = '#92CFFF')) %>%
  add_trace(y = ~editada1, name = 'Opción 1 (90% de original)', type = 'bar', marker = list(color = '#193B7B')) %>%
  layout(
    title = "Comparación de la reducción de la 'Opción 1' con el original",
    xaxis = list(title = 'Empleado'),
    yaxis = list(title = 'Prima reducida'),
    barmode = 'group',
    legend = list(x = 0, y = 1, bgcolor = "white", bordercolor = "black", borderwidth = 1),
    margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4)
  )

fig_comparacion1

fig_comparacion2 <- plot_ly(tabla_para_graficar, x = ~Empleado) %>%
  add_trace(y = ~original, name = 'Original', type = 'bar', marker = list(color = '#92CFFF')) %>%
  add_trace(y = ~editada2, name = 'Opción 2 (90% de original)', type = 'bar', marker = list(color = '#193B7B')) %>%
  layout(
    title = "Comparación de la reducción de la 'Opción 2' con el original",
    xaxis = list(title = 'Empleado'),
    yaxis = list(title = 'Prima reducida'),
    barmode = 'group',
    legend = list(x = 0, y = 1, bgcolor = "white", bordercolor = "black", borderwidth = 1),
    margin = list(l = 50, r = 50, b = 50, t = 50, pad = 4)
  )

fig_comparacion2